home *** CD-ROM | disk | FTP | other *** search
/ Resource Library: Multimedia / Resource Library: Multimedia.iso / space / software / src / pcdriv.for < prev    next >
Encoding:
Text File  |  1993-06-12  |  11.1 KB  |  271 lines
  1.     PROGRAM PCDRIV
  2. C********************************************************************
  3. C  THIS IS A SAMPLE PROGRAM WHICH READS AND DECOMPRESSES VOYAGER
  4. C  IMAGES AND WRITES THEM OUT IN PDS LABELLED FORMAT.  IT ALSO
  5. C  MODIFIES THE PDS LABELS TO REFLECT THE CONVERSION FROM VARIABLE
  6. C  TO FIXED RECORD FORMAT.  IT USES THE SUBROUTINES IN DECOMP.FOR
  7. C  TO PERFORM THE DECOMPRESSION.  TWO VERSIONS OF THE DRIVER EXIST, 
  8. C  ONE WHICH RUNS ON THE IBM PC USING MICROSOFT FORTRAN, VERSION 4.XX,
  9. C  AND ONE WHICH RUNS UNDER VAX/VMS FORTRAN.  THE TWO VERSIONS ARE 
  10. C  IDENTICAL EXCEPT FOR THE FILE OPEN STATEMENTS AND VARIABLE
  11. C  LENGTH RECORD I/O (READ STATEMENTS).
  12. C
  13. C_HIST
  14. C  JUL88 PC AND VAX VERSIONS BY MIKE MARTIN 1988/07/30, WITH 
  15. C  ASSISTANCE FROM ROGER BOWEN, WHO CODED THE FIRST PC VERSIONS
  16. C  OF THESE ROUTINES.
  17. C
  18. C  INPUTS   - INPUT FILE TO BE DECOMPRESSED.
  19. C
  20. C  OUTPUTS  - OUTPUT FILE CONTAINING DECOMPRESSED IMAGE.
  21. C
  22. C  TO COMPILE AND LINK UNDER MICROSOFT FORTRAN USE THE COMMAND:
  23. C
  24. C    FL /FPi PCDRIV.FOR DECOMP.FOR
  25. C
  26. C  TO COMPILE AND LINK USING VAX/VMS FORTRAN USE THE COMMANDS:
  27. C
  28. C    FOR  VAXDRIV,DECOMP
  29. C    LINK VAXDRIV,DECOMP  
  30. C_END
  31. C_VARS
  32.     CHARACTER  NAME*80, INAME*80, LABSTRING*80, OUTSTRING*2508,
  33.      1           IBUF(2048), OBUF(2508),TEMPSTRING*80
  34.         CHARACTER  CR,LF,BLANK
  35.         INTEGER*2  TOTAL_BYTES,LINE,I,J,NLEN
  36.     INTEGER*4  HIST(512),HISTIN(209)
  37.         INTEGER*4  LEN,NS
  38.     EQUIVALENCE (IBUF,LABSTRING,HISTIN), (OBUF,OUTSTRING)
  39. C********************************************************************
  40. C
  41. C INITIALIZE SOME CONSTANTS
  42. C
  43. C********************************************************************
  44.         CR    = CHAR(13)
  45.         LF    = CHAR(10)
  46.         BLANK = CHAR(32)
  47.         NS    = 836
  48. C********************************************************************
  49. C
  50. C GET INPUT AND OUTPUT FILE NAMES AND OPEN THE FILES
  51. C
  52. C********************************************************************
  53.     WRITE (*,1000)
  54. 1000    FORMAT(' ENTER NAME OF FILE TO BE DECOMPRESSED: ')
  55. 1020    FORMAT(A)
  56.     READ  (*,1020) INAME
  57.         WRITE (*,1010)
  58. 1010    FORMAT(' ENTER NAME OF UNCOMPRESSED OUTPUT FILE:')
  59.         READ  (*,1020) NAME
  60.     OPEN  (10, FILE=INAME, FORM='BINARY',BLOCKSIZE=51200)
  61.     OPEN  (11, FILE=NAME, STATUS='NEW', FORM='BINARY')
  62.  
  63. C********************************************************************
  64. C
  65. C READ AND PROCESS THE COMPRESSED FILE LABELS.  
  66. C 
  67. C ALL THE LABELS ARE CONCATINATED INTO AN ARRAY, TO ALLOW THE 50-ODD 
  68. C LABEL LINES TO BE WRITTEN OUT AS 3-FIXED-LENGTH RECORDS ON THE VAX.
  69. C
  70. C********************************************************************
  71.         TOTAL_BYTES = 0
  72. 100    READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  73. C********************************************************************
  74. C
  75. C EDIT THE PDS LABELS WHICH HAVE TO BE CHANGED.
  76. C
  77. C********************************************************************
  78. C CHANGE THE LENGTH FIELD OF THE SFDU LABEL
  79. C********************************************************************
  80.         I = INDEX(LABSTRING,'NJPL1I00PDS1')
  81.         IF (I .EQ. 1) THEN 
  82.           TEMPSTRING = LABSTRING(1:12) // '00673816' // 
  83.      1                 LABSTRING(21:NLEN)
  84.           OUTSTRING = TEMPSTRING(1:NLEN) // CR // LF
  85.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  86.           GOTO 100
  87.         ENDIF
  88. C********************************************************************
  89. C CHANGE THE RECORD TYPE FROM VARIABLE TO FIXED
  90. C********************************************************************
  91.         I = INDEX(LABSTRING,'RECORD_TYPE')
  92.         IF (I .EQ. 1) THEN 
  93.           TEMPSTRING = LABSTRING(1:35) // 'FIXED_LENGTH'
  94.           NLEN = NLEN-3
  95.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  96.      1                // CR // LF
  97.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  98.           GOTO 100
  99.         ENDIF
  100. C********************************************************************
  101. C CHANGE THE FILE RECORD COUNT TO REFLECT THE FIXED STRUCTURE
  102. C********************************************************************
  103.         I = INDEX(LABSTRING,'FILE_RECORDS')
  104.         IF (I .EQ. 1) THEN 
  105.           TEMPSTRING = LABSTRING(1:35) // '806'
  106.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  107.      1                // CR // LF
  108.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  109.           GOTO 100
  110.         ENDIF
  111. C********************************************************************
  112. C CHANGE THE COUNT OF LABEL RECORDS TO 3
  113. C********************************************************************
  114.         I = INDEX(LABSTRING,'LABEL_RECORDS')
  115.         IF (I .EQ. 1) THEN 
  116.           TEMPSTRING = LABSTRING(1:35) // '3'
  117.           NLEN = NLEN -1
  118.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  119.      1                // CR // LF
  120.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  121.           GOTO 100
  122.         ENDIF
  123. C********************************************************************
  124. C CHANGE THE LOCATION POINTER OF THE HISTOGRAM TO RECORD 4
  125. C********************************************************************
  126.         I = INDEX(LABSTRING,'^IMAGE_HISTOGRAM')
  127.         IF (I .EQ. 1) THEN 
  128.           TEMPSTRING = LABSTRING(1:35) // '4'
  129.           NLEN = NLEN -1
  130.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  131.      1                // CR // LF
  132.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  133.           GOTO 100
  134.         ENDIF
  135. C********************************************************************
  136. C DELETE THE ENCODING HISTOGRAM LOCATION POINTER
  137. C********************************************************************
  138.         I = INDEX(LABSTRING,'^ENCODING_HISTOGRAM')
  139.         IF (I .EQ. 1) GOTO 100
  140. C********************************************************************
  141. C CHANGE THE LOCATION POINTER OF THE ENGINEERING TABLE TO RECORD 6
  142. C********************************************************************
  143.         I = INDEX(LABSTRING,'^ENGINEERING_TABLE')
  144.         IF (I .EQ. 1) THEN 
  145.           TEMPSTRING = LABSTRING(1:35) // '6'
  146.           NLEN = NLEN -1
  147.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  148.      1                // CR // LF
  149.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  150.           GOTO 100
  151.         ENDIF
  152. C********************************************************************
  153. C CHANGE THE LOCATION POINTER OF THE IMAGE TO RECORD 7
  154. C********************************************************************
  155.         I = INDEX(LABSTRING,'^IMAGE')
  156.         IF (I .EQ. 1) THEN 
  157.           TEMPSTRING = LABSTRING(1:35) // '7'
  158.           NLEN = NLEN -1
  159.           OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // TEMPSTRING(1:NLEN) 
  160.      1                // CR // LF
  161.           TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  162.           GOTO 100
  163.         ENDIF
  164. C********************************************************************
  165. C DELETE THE ENCODING HISTOGRAM OBJECT DEFINITION
  166. C********************************************************************
  167.         I = INDEX(LABSTRING,
  168.      1            'OBJECT                           = ENCODING_')
  169.         IF (I .EQ. 1) THEN 
  170.           READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  171.           READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  172.           READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  173.       READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  174.           GOTO 100
  175.         ENDIF
  176. C********************************************************************
  177. C DELETE THE ENCODING TYPE KEYWORD IN THE IMAGE OBJECT DEFINITION
  178. C********************************************************************
  179.         I = INDEX(LABSTRING,' ENCODING')
  180.         IF (I .EQ. 1) GOTO 100
  181. C********************************************************************
  182. C IF WE GET HERE JUST WRITE OUT THE LABEL
  183. C********************************************************************
  184.         OUTSTRING = OUTSTRING(1:TOTAL_BYTES) // LABSTRING(1:NLEN) 
  185.      1              // CR // LF
  186.         TOTAL_BYTES = TOTAL_BYTES + NLEN + 2
  187.         I= INDEX(LABSTRING,'END') 
  188.         IF (I .EQ. 1 .AND. NLEN .EQ. 3) GOTO 300
  189.         GOTO 100
  190. C********************************************************************
  191. C PAD OUT LABELS TO MULTIPLE OF 836
  192. C********************************************************************
  193. 300     DO 310 I=TOTAL_BYTES+1,2508
  194. 310     OBUF(I) =  BLANK
  195. C********************************************************************
  196. C NOW WRITE OUT THE LABEL RECORDS IN 3-WRITES, FILLING OUT THE THIRD
  197. C RECORD TO 836 BYTES WITH BLANKS.
  198. C********************************************************************
  199.         WRITE(11) (OBUF(I), I=   1,  836)
  200.         WRITE(11) (OBUF(I), I= 837, 1672)
  201.         WRITE(11) (OBUF(I), I=1673, 2508)
  202. C********************************************************************
  203. C
  204. C READ AND WRITE THE IMAGE HISTOGRAM AS TWO RECORDS, FILLING OUT THE
  205. C SECOND RECORD TO 836 BYTES WITH BLANKS.
  206. C
  207. C********************************************************************
  208.         DO 320 J=1,2
  209.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  210.         IF (NLEN .EQ. 836) WRITE(11) (IBUF(I), I=1, NLEN)
  211. 320     CONTINUE
  212.         DO 330 I=NLEN+1,836
  213. 330     IBUF(I) =  BLANK
  214.         WRITE(11) (IBUF(I), I=1, 836)
  215. C********************************************************************
  216. C
  217. C READ THE ENCODING HISTOGRAM, AND LOAD THE HIST ARRAY FOR USE BY
  218. C THE DECOMPRESSION SUBROUTINES.
  219. C
  220. C********************************************************************
  221.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  222.         DO 340 I=1,209
  223. 340       HIST(I) = HISTIN(I)
  224.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  225.         DO 350 I=1,209
  226. 350       HIST(I+209) = HISTIN(I)
  227.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  228.         DO 360 I=1,93
  229. 360       HIST(I+418) = HISTIN(I)
  230. C********************************************************************
  231. C
  232. C READ AND WRITE THE ENGINEERING SUMMARY AS ONE RECORD, FILLING OUT 
  233. C THE RECORD TO 836 BYTES WITH BLANKS.
  234. C
  235. C********************************************************************
  236.     READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  237.         DO 370 I=NLEN+1,836
  238. 370     IBUF(I) = BLANK
  239.         WRITE(11) (IBUF(I), I=1, 836)
  240. C********************************************************************
  241. C
  242. C INITIALIZE THE DECOMPRESSION.
  243. C
  244. C********************************************************************
  245.     WRITE(*,*) 'INITIALIZING DECOMPRESSION ROUTINE...'
  246.     CALL DECMPINIT(HIST)
  247. C********************************************************************
  248. C
  249. C PERFORM THE DECOMPRESSION.
  250. C
  251. C********************************************************************
  252.     WRITE(*,*) 'DECOMPRESSING DATA...'
  253.         LINE=0
  254. 400    READ(10, END=500) NLEN, (IBUF(I), I=1, NLEN+MOD(NLEN,2))
  255.         LINE = LINE + 1
  256.                 LEN = NLEN
  257.                 CALL DECOMPRESS(IBUF, OBUF, LEN, NS)
  258.         WRITE(11) (OBUF(I), I=1, NS)
  259.                 J = MOD(LINE,100)
  260.                 IF (J .EQ. 0) WRITE (*,'(I5,A6)') LINE,' LINES'
  261.                 IF (LINE .EQ. 800) GOTO 500
  262.                 GO TO 400
  263. C********************************************************************
  264. C
  265. C DONE.  CLOSE FILES AND GET OUT OF HERE.
  266. C
  267. C********************************************************************
  268. 500    CLOSE(10)
  269.     CLOSE(11)
  270.     END
  271.